home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
rdkybd.zip
/
RDKYBD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
19KB
|
478 lines
{$R-,S-,T-,V-}
{ Turbo Pascal 4.0 unit of keyboard routines to read and validate byte/
integer/real number/string/password entry with cursor key editing.
The enter key does not advance the cursor to the next line. Use GotoXY
before call to display entry at a specific screen position. Use Writeln
after the call to advance the cursor to the next line when using a scrolling
display. Set background and text colors with TextBackground and TextColor.}
{ John Haluska, CIS 74000,1106 }
unit Rdkybd;
interface
uses Crt;
var
ErrorToneEnb : boolean; {Enables (true) or disables (false) ErrorTone }
procedure ErrorTone;
procedure Password(var P : string);
procedure ReadByte(var N : byte);
procedure ReadIntgr(var N : integer);
procedure ReadLongInt(var N : longint);
procedure ReadByteMinMax(Min,Max : byte; var N : byte);
procedure ReadIntgrMinMax(Min,Max : integer; var N : integer);
procedure ReadLongIntMinMax(Min,Max : longint; var N : longint);
procedure ReadReal(var N : real);
procedure ReadRealMinMax(Min,Max : real; var N : real);
procedure ReadString (var S : string);
implementation
{-----------------------------------------------------------------------------}
{ ErrorTone generates a 120 Hz tone for .1 second if unit global variable
ErrorToneEnb is true (default). The caller can set ErrorToneEnb := False
to disable ErrorTone. }
procedure ErrorTone;
{Requires unit global variable ErrorToneEnb}
begin
if ErrorToneEnb then
begin
Sound(120); Delay(100); NoSound;
end;
end; {ErrorTone}
{-----------------------------------------------------------------------------}
{ Password reads a string of characters and echos the entered characters as
asterisks to the display. The Bksp and Esc keys edit the input. The Enter
key terminates the input and does not advance the cursor to the next line. }
procedure Password(var P : string);
{ Requires procedure ErrorTone }
var
C : char;
I,X,Y : byte;
begin
P[0] := #0;
X := WhereX; Y := WhereY;
repeat
C := ReadKey;
case C of
#32..#127 : begin
P := P + C;
Write('*');
end;
#8 : begin {Backspace}
if Length(P) > 0 then
begin
Delete(P,Length(P),1);
Write(#8,' ',#8);
end
else ErrorTone;
end;
#27 : begin {Escape}
GotoXY(X,Y);
for I := 1 to Length(P) do Write(' ');
GotoXY(X,Y);
P[0] := #0;
end;
#13 : ; {CR}
#0 : begin {Extended Key}
C := ReadKey; ErrorTone;
end;
else ErrorTone;
end;
until C = #13; {CR}
end {Password};
{-----------------------------------------------------------------------------}
{ ReadByte, ReadIntgr, and ReadLongInt are similar to the corresponding MinMax
procedures except these procedures will accept any valid corresponding byte,
integer, or longinteger. Example: ReadIntgr(N) will erase the input if
35000 is entered. }
procedure ReadByte(var N : byte);
{ Requires procedure ReadLongIntMinMax }
var M : longint;
begin
ReadLongIntMinMax(0,255,M);
N := M;
end; {ReadByte}
procedure ReadIntgr(var N : integer);
{ Requires procedure ReadLongIntMinMax }
var M : longint;
begin
ReadLongIntMinMax(-32768,32767,M);
N := M;
end; {ReadIntgr}
procedure ReadLongInt(var N : longint);
{ Requires procedure ReadLongIntMinMax }
begin
ReadLongIntMinMax(-2147483647,2147483647,N);
end; {ReadLongInt}
{-----------------------------------------------------------------------------}
{ ReadByteMinMax, ReadIntgMinMax, and ReadLongIntMinMax read and display the
keyboard entry at the current cursor location until valid data (characters
(-,0-9,.,), range min to max) is entered. If the data is not valid, the
entry is erased, warning sounded, and the cursor is positioned to the start
of the field. Min and max are assumed to be valid corresponding bytes,
integers or longintegers. If max is less than min, max and min are
swapped. The Backspace, Delete, Left/Right Arrow, Home, End, and Esc keys
can be used to edit the data entry. Enter terminates the data entry and does
not advance the cursor to the next line. Example: ReadIntgrMinMax(-5,5,N )
will return a valid integer number N in the range -5 to 5 from the keyboard.}
procedure ReadByteMinMax(Min,Max : byte; var N : byte);
{ Requires procedure ReadLongIntMinMax }
var M : longint;
begin
ReadLongIntMinMax(Min,Max,M);
N := M;
end; {ReadByteMinMax}
procedure ReadIntgrMinMax(Min,Max : integer; var N : integer);
{ Requires procedure ReadLongIntMinMax }
var M : longint;
begin
ReadLongIntMinMax(Min,Max,M);
N := M;
end; {ReadIntgrMinMax}
procedure ReadLongIntMinMax(Min,Max : longint; var N : longint);
{ Requires procedure ErrorTone }
var
S : string;
C : char;
Error : integer;
Temp : longint;
I,X,Y : byte;
OK : boolean;
begin
X := WhereX; Y := WhereY;
if Min > Max then {if min greater than max, swap min and max}
begin
Temp := Min; Min := Max; Max := Temp;
end;
repeat
S := ''; I := 0;
repeat
C := ReadKey;
case C of
'-','0'..'9': begin {-,0..9}
if (X + I) < 80 then
begin
Inc(I);
Insert(C,S,I);
GotoXY(X+I-1,Y);
Write(Copy(S,I,Length(S)-I+1));
GotoXY(X+I,Y);
end
else ErrorTone; {Entry field cannot go beyond col 79}
end;
#8 : begin {Backspace}
Delete(S,I,1);
if I > 0 then
begin
Dec(I);
GotoXY(X,Y);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#13 : ; {CR}
#27 : begin {Escape}
GotoXY(X,Y);
for I := 1 to Length(S) do Write(' ');
GotoXY(X,Y);
S := ''; I := 0;
end;
#0 : begin {Extended key}
C := ReadKey;
case C of
#83 : begin {Delete}
if I <> Length(S) then
begin
Inc(I);
Delete(S,I,1);
GotoXY(X,Y);
Dec(I);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#75 : begin {Left Arrow}
if (X+I) > X then
begin
Dec(I); GotoXY(X+I,Y);
end;
end;
#77 : begin {Right Arrow}
if I < Length(S) then
begin
Inc(I); GotoXY(X+I,Y);
end;
end;
#71 : begin {Home}
GotoXY(X,Y); I := 0;
end;
#79 : begin {End}
GotoXY(X + Length(S),Y);
I := Length(S);
end;
else ErrorTone;
end;
end;
else ErrorTone;
end;
until C = #13; {CR ends entry}
GotoXY(X,Y);
for I := 1 to Length(S) do Write(' ');
GotoXY(X,Y);
Val(S,N,Error);
if (Error = 0) and (N >= Min) and (N <= Max) then OK := True
else
begin
OK := False;
ErrorTone;
end;
until OK;
Write(N);
end {ReadLongIntMinMax};
{-----------------------------------------------------------------------------}
{ ReadReal is similar to ReadRealMinMax except ReadReal accepts any valid
real number. Example: ReadReal(Num) will return only a valid real number. }
procedure ReadReal(var N : real);
{ Requires procedure ReadRealMinMax }
begin
ReadRealMinMax(-9.999E37,9.999E37,N);
end; {ReadReal}
{-----------------------------------------------------------------------------}
{ ReadRealMinMax reads and displays at the current location the keyboard entry
until a valid real number (characters (-,0-9,.,E,e), range min to max, up to
up to 11 digits in mantisa) is entered. Invalid keystrokes are ignored. If
the data is not valid, the entry is erased, warning sounded, and the cursor
is positioned to the start of the field. Max must be greater than min. If
min is greater than max, then max and min are swapped. The Backspace,
Delete, Left/Right Arrow, Home, End, and Esc keys can be used to edit the
data entry. Enter terminates the data entry and does not advance the cursor
to the next line. Example: ReadRealMinMax(10.0,15.0,Num) will return a valid
real number Num in the range 10 to 15 }
procedure ReadRealMinMax(Min,Max : real; var N : real);
{ Requires procedure ErrorTone }
var
S : string[80];
C : char;
Error,Indx : integer;
Temp : real;
I,X,Y : byte;
OK : boolean;
begin
X := WhereX; Y := WhereY;
if Min > Max then {if min greater than max, swap min and max}
begin
Temp := Min; Min := Max; Max := Temp;
end;
repeat
S := ''; I := 0;
repeat
C := ReadKey;
case C of
'-','.',
'0'..'9',
'E','e' : begin {-,.,0..9,E,e}
if (X + I) < 80 then
begin
Inc(I);
Insert(Upcase(C),S,I);
GotoXY(X+I-1,Y);
Write(Copy(S,I,Length(S)-I+1));
GotoXY(X+I,Y);
end
else ErrorTone; {Entry field cannot go beyond col 79}
end;
#8 : begin {Backspace}
Delete(S,I,1);
if I > 0 then
begin
Dec(I);
GotoXY(X,Y);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#13 : ; {CR}
#27 : begin {Escape}
GotoXY(X,Y);
for I := 1 to Length(S) do Write(' ');
GotoXY(X,Y);
S := ''; I := 0;
end;
#0 : begin {Extended key}
C := ReadKey;
case C of
#83 : begin {Delete}
if I <> Length(S) then
begin
Inc(I);
Delete(S,I,1);
GotoXY(X,Y);
Dec(I);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#75 : begin {Left Arrow}
if (X+I) > X then
begin
Dec(I); GotoXY(X+I,Y);
end;
end;
#77 : begin {Right Arrow}
if I < Length(S) then
begin
Inc(I); GotoXY(X+I,Y);
end;
end;
#71 : begin {Home}
GotoXY(X,Y); I := 0;
end;
#79 : begin {End}
GotoXY(X + Length(S),Y);
I := Length(S);
end;
else ErrorTone;
end;
end;
else ErrorTone;
end;
until C = #13; {CR ends entry}
if Pos('.',S)=1 then S:='0'+S; {if only digits to right of DP entered}
GotoXY(X,Y);
for I := 1 to Length(S) do Write(' ');
GotoXY(X,Y);
Val(S,N,Error);
if (Error = 0) and (N >= Min) and (N <= Max) then OK := True
else
begin
OK := False; ErrorTone;
end;
until OK;
Indx := Pos('E',S); {exponential notation}
if Indx > 0 then
begin
if N > 0 then Inc(Indx); {exponent positive}
Write(N:Indx+3);
end
else
begin
Indx := Pos('.',S);
if Indx > 0 then {fixed point notation}
Write(N:Length(S):Length(S)-Indx) {fixed with dec pt}
else Write(N:Length(S):0); {fixed, no dec pt}
end;
end {ReadRealMinMax};
{-----------------------------------------------------------------------------}
{ ReadString reads a string of characters and echos the entered characters to
the display. The Bksp, Del, Left/Right Arrow, Home, End, and Esc keys can
be used to edit the data entry. Enter terminates the data entry and does
not advance the cursor to the next line. The entered string must be on one
80 column line. Example: ReadString(Str) returns the keyboard entry for
string Str. }
procedure ReadString(var S : string);
{ Requires procedure ErrorTone }
var
C : char;
I,X,Y : byte;
begin
S := ''; I := 0;
X := WhereX; Y := WhereY;
repeat
C := ReadKey;
case C of
#32..#127 : begin
if (X + I) < 80 then
begin
Inc(I);
Insert(C,S,I);
GotoXY(X+I-1,Y);
Write(Copy(S,I,Length(S)-I+1));
GotoXY(X+I,Y);
end
else ErrorTone; {Entry field cannot go beyond col 79}
end;
#8 : begin {Backspace}
Delete(S,I,1);
if I > 0 then
begin
Dec(I);
GotoXY(X,Y);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#13 : ; {CR}
#27 : begin {Escape}
GotoXY(X,Y);
for I := 1 to Length(S) do Write(' ');
GotoXY(X,Y);
S := ''; I := 0;
end;
#0 : begin
C := Readkey;
case C of
#83 : begin {Delete}
if I <> Length(S) then
begin
Inc(I);
Delete(S,I,1);
GotoXY(X,Y);
Dec(I);
Write(S,' ');
GotoXY(X+I,Y);
end
else ErrorTone;
end;
#75 : begin {Left Arrow}
if (X+I) > X then
begin
Dec(I); GotoXY(X+I,Y);
end;
end;
#77 : begin {Right Arrow}
if I < Length(S) then
begin
Inc(I); GotoXY(X+I,Y);
end;
end;
#71 : begin {Home}
GotoXY(X,Y); I := 0;
end;
#79 : begin {End}
GotoXY(X + Length(S),Y);
I := Length(S);
end;
else ErrorTone;
end;
end;
else ErrorTone;
end;
until C = #13;
end {ReadString};
{-----------------------------------------------------------------------------}
begin
ErrorToneEnb := True; { Enable ErrorTone }
end.
